home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
QRZ! Ham Radio 8
/
QRZ Ham Radio Callsign Database - Volume 8.iso
/
mac
/
german
/
tcpip
/
gp160.exe
/
#GPRI.EXE
/
MINESEEK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-09-13
|
9KB
|
316 lines
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V+,X-}
{$M 1024,0,0}
PROGRAM Minen_Treter;
USES DOS,GPRI;
CONST MAXX = 9;
MAXY = 9;
nMienen = 10;
MaxVersuche = 12;
GameOver : Boolean = FALSE;
CONST MIENE = 1; MARKIERT=2; OFFEN=4;
VAR acker : ARRAY[1..MAXX,1..MAXY] OF Byte; {* Bit 0 Miene
* 1 markiert als Miene
* 2 bereits draufgetreten
*}
anzahl : ARRAY[1..MAXX, 1..MAXY] OF Byte; {* Anzahl der nachbarMienen *}
path : STRING; { Pfad ins RUN-Direactory }
command : STRING; { Kommando-String }
i, j, k : BYTE; { irgendwelche Zähler; i bevorzugt Zeile, j Spalte }
nMarkiert : INTEGER; { Zählt die Schüsse }
nFelder, { Felder, die noch frei sind }
nTritte : WORD; { " " Treffer (was sonst?) }
PROCEDURE hilfe; { Ist noch ausbaufähig, bei /H soll mal'n größerer TEXT kommen... }
{ Anm. von DH1DAE: Wurde bei der GPRI-Version getan :-) }
VAR
F : Text;
S : String;
BEGIN
Assign(F,Path+'MINESEEK.HLP');
Reset(F);
IF IOResult = 0 THEN BEGIN
WHILE NOT EoF(F) DO BEGIN
Readln(F,S);
SendString(S+#13);
END;
Close(F);
END ELSE BEGIN
S := 'Leider ist das Helpfile bei einer Explosion einer Mine'#13+
'zerstört worden. Sri...'#13;
SendString(S);
END;
SendString('>');
END;
PROCEDURE new_game; { Saubermänner mit /N, Erstinstallation, oder hat mal jemand gesiegt ? }
VAR i, a, b : BYTE;
x,y : SHORTINT;
BEGIN {$I+}
FillChar (acker, Sizeof(Acker), #0 ); {* Nieder mit den Schleifen *}
FillChar (anzahl, Sizeof(Acker), #0 ); {* dto. *}
RANDOMIZE; { Naja, ob der Zufall will ? }
FOR i := 1 TO NMieneN DO {* Mienen legen, wie einst bei der NVA & Co. :-< *}
BEGIN
REPEAT
a := Random(maxx)+1;
b := Random(maxy)+1;
UNTIL (acker[a,b] = 0);
Acker[a,b] := Miene;
for x := a-1 to a+1 DO
FOR y := b-1 TO b+1 DO
IF (x>=1) AND (x<=MAXX) AND (y>=1) AND (y<=MAXX) THEN
IF Anzahl[x,y] <> 255 THEN Inc( anzahl[x,y] );
Anzahl[a,b] := 255;
END;
nMarkiert := 0; { Munition bereitlegen, Rohre frei, }
nTritte := 0; { und Treffer-Tafel putzen. }
nFelder := MaxX*MaxY;
END;
PROCEDURE Ausgabe(fAlles:BOOLEAN); { Gibt den aktuellen Spielstand aus, wo nötig }
VAR i, j: BYTE;
S : String;
BEGIN
S := #13' ';
FOR i := 1 TO maxX DO S := S+' '+char(i+ord('A')-1);
S := S+#13;
FOR j := 1 TO maxY DO
BEGIN
S := S+Chr(j+48)+' '; { Zeilennummern?! Naja, das Spiel ist einfach wie BASIC... }
FOR i := 1 TO 9 DO
IF (acker[i,j] AND MARKIERT) <> 0
THEN S := S+' *'
ELSE IF ((acker[i,j] AND OFFEN) <> 0) OR fAlles
THEN IF anzahl[i,j] = 0
THEN S := S+' -'
ELSE IF anzahl[i,j] = 255 THEN S := S+' *'
ELSE
S := S+' '+Chr(anzahl[i,j]+48)
ELSE S := S+' ?'; {* unbetreten *}
S := S+#13;
END;
SendString(S);
END;
PROCEDURE statistik; { Verhältnis von Schüssen zu Treffern (oder umgekehrt) }
VAR
S : String;
S1 : String[2];
BEGIN
S := #13+
'Kleine Statistik:'#13+
' Tritte : ';
Str(nTritte,S1);
S := S+S1+#13+
' Gefundene Minen : ';
Str(nMarkiert,S1);
S := S+S1+#13;
IF nMarkiert>0 THEN BEGIN { aber nicht durch 0 teilen }
Str(Round(nMarkiert/nTritte*100),S1);
S := S+' Treffquote : '+S1+'%'#13;
END;
S := S+#13;
SendString(S);
END;
PROCEDURE Bumm ( i, j:BYTE ); { Handelt alle TREFFER ab, auch mehrfache }
VAR k, l, m : BYTE;
ende : BOOLEAN;
S : String;
BEGIN
S := #13+
'BUMM ! Auf Position '+Chr(I+64)+Chr(J+48)+' lag ''ne Mine... GAME OVER'#13;
SendString(S);
Ausgabe(TRUE); { Spielstand ausgeben nicht vergessen, }
statistik; { mit Statistik natürlich, }
SendString('Ein neues Spiel? (J/N) >');
GameOver := TRUE;
END;
CONST RekursionTiefe : WORD = 0;
nAufdeck : WORD = 0;
VAR
S : String;
PROCEDURE Aufdecken ( i, j: BYTE );
VAR x,y : SHORTINT;
BEGIN
Inc(RekursionTiefe);
Inc( nAufdeck);
Dec(nFelder);
acker[i,j] := acker[i,j] OR OFFEN AND NOT Markiert;
IF anzahl[i,j] = 0
THEN BEGIN {* Rekursiv alle Felder mit 0 NachbarMienen sowie deren unmittelbaren Nachbarn aufdecken *}
FOR x := i-1 to i+1 DO
FOR y := j-1 TO j+1 DO
IF (x>=1) AND (x<=MAXX) AND (y>=1) AND (y<=MAXX) THEN
IF ((acker[x,y] AND OFFEN) = 0) THEN Aufdecken(x,y);
END;
IF RekursionTiefe<=1 THEN
BEGIN
IF nAufdeck > 1 THEN BEGIN
Str(nAufdeck,S);
SendString('Insgesamt '+S+' gleichzeitig aufgedeckt !'#13);
END;
nAufdeck := 0;
END;
Dec(RekursionTiefe);
END;
PROCEDURE Markiere ( i, j: BYTE );
BEGIN
IF ((acker[i,j] AND OFFEN) <> 0)
THEN SendString(' Kann nicht markieren: Feld ist schon aufgedeckt !'#13)
ELSE BEGIN
acker[i,j] := acker[i,j] XOR Markiert;
IF (acker[i,j] AND Markiert) <> 0 THEN BEGIN
Inc(nMarkiert);
Dec(nFelder);
END ELSE BEGIN
Dec(nMarkiert);
Inc(nFelder);
END;
END;
END;
PROCEDURE Intro; far;
VAR
S : String;
BEGIN
ProgrammEnde := FALSE;
Path := ParamStr(0);
WHILE (Path[0] > #0) AND (Path[Byte(Path[0])] <> '\') DO Dec(Path[0]);
New_Game;
{ Mit Titeln protzen? Aber nicht doch... }
S := #13' Minen SUCHEN - V2.00 - (C) 1992 by DG9EP & DF3VI'#13+
' (GPRI-Implementation 1992 by DH1DAE)'#13#13+
' /H = Hilfe /E = Spiel beenden'#13#13;
SendString(S);
Ausgabe(FALSE);
SendString('>');
END;
PROCEDURE Parser (S : String); far;
VAR
P,N : Byte;
BEGIN
Dec(S[0]);
FOR k := 1 TO Byte(S[0]) DO S[k] := upcase (S[k]); { In Großbuchstaben wandeln }
IF GameOver THEN BEGIN
IF S[1] = 'J' THEN BEGIN
GameOver := FALSE;
New_Game;
SendString('Also dann, auf ein neues... :-)'#13#13);
Ausgabe(FALSE);
SendString('>');
END ELSE BEGIN
ProgrammEnde := TRUE;
SendString('Tschuess...'#13);
END;
END ELSE BEGIN
P := Pos(' ',S);
N := 0;
REPEAT
IF P = 0 THEN P := Byte(S[0])+1;
Command := Copy(S,1,P-1);
Delete(S,1,P);
P := Pos(' ',S);
IF command='/S' { Für die Buchhalter und so... }
THEN BEGIN
statistik;
IF N > 0 THEN Ausgabe(FALSE);
SendString('>');
Exit;
END;
IF command='/H' THEN BEGIN
hilfe; { Da solls mal nen längeren(!) Text geben }
Exit;
END;
IF Command = '/E' THEN BEGIN
SendString('Spiel vorzeitig abgebrochen.'#13);
ProgrammEnde := TRUE;
Exit;
END;
{* folgendes muesste noch Konstantenmaessig abgescheckt werden, aber hab
* ich keinen Bock mehr fuer *}
IF NOT ( command[1] IN ['A'..'I'] ) THEN BEGIN
SendString('Ungueltige Koordinate!'#13'>');
Exit;
END;
IF NOT ( command[2] IN ['1'..'9'] ) THEN BEGIN
SendString('Ungueltige Koordinate!'#13'>');
Exit;
END;
i := ORD ( command[1] ) -64; { Und Zahlen aus den Zeichen machen, ist irgendwie flexibler, }
j := ORD ( command[2] ) -48; { als wenn man von 'A' bis 'I' zählt (was aber auch geht -> V1.0). }
Inc (nTritte); { Munition genau zählen }
IF (length(command)>2) AND (upCase (command[3]) = 'M')
THEN BEGIN
Markiere(i,j);
END ELSE
IF (acker[i,j] AND Miene)<> 0
THEN BEGIN
Bumm ( i, j ); { Wenn da eine Miene ist, PÄNG }
Exit;
END ELSE
Aufdecken ( i, j ); { sonst Hurra, wir leben noch halt ... }
Inc(N);
IF NOT GameOver AND (nFelder = 0) THEN BEGIN
S := #13#13'**************************************'#13+
'* Gratulation, Du hast es geschafft! *'#13+
'**************************************'#13#13;
SendString(S);
Ausgabe(FALSE);
Statistik;
SendString(#13'Ein weiters Spiel ? (J/N) >');
GameOver := TRUE;
Exit;
END ELSE
IF nMarkiert > MaxVersuche THEN BEGIN
SendString(#13'Sri, Du hast soeben Dein letztes Minen-Raeumgeraet verbraucht,'#13+
'deshalb: GAME OVER!!'#13#13);
Ausgabe(TRUE);
Statistik;
SendString(#13'Ein weiters Spiel ? (J/N) >');
GameOver := TRUE;
Exit;
END;
UNTIL (Byte(S[0]) = 0);
Ausgabe(FALSE);
SendString('>');
END;
END;
BEGIN
IF NOT TaskInit(@Intro,@Parser,NIL,NIL) THEN BEGIN
Writeln('Dieses Programm kann nur als GP Remote-Programm gestartet werden.');
Halt;
END;
Keep(0);
END.